home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
wedits22.zip
/
WECHAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-18
|
6KB
|
245 lines
UNIT WEChat; {$O+}
{ -- Chat module for WWIVEdit 2.2
-- Last Modified 8/13/91
-- Written By:
-- Adam Caldwell
--
-- This code is limited Public Domain. See WWIVEDIT.PAS for more details.
--
-- Purpose: To do what was previously though un-doable... Create a two
-- way (split screen) color chat, using the BBS I/O routines (and some
-- fancy programming).
--
-- Known "errors" : If a user hangs up/gets disconnected while in this
-- chat mode, the computer will lock up.
--
-- Proposed fix (as of yet un-implemented):
-- Install an interrupt handler that will intercept the BBS "DOS"
-- call that signals that a program should be terminated. When
-- this call is seen, restore the Int 9 vector, and let the program
-- be terminated. Haven't had time to do this yet. I tried it once,
-- but couldn't get it to work... If anyone wants to do this, please
-- do and send me the solution! :-)
-- }
{$R-,V-,S-,B-,E-,N-} { These Optomize things as much as possible }
INTERFACE
PROCEDURE Chat(LineLen,ScreenHeight:integer);
IMPLEMENTATION
USES WEKbd, WEString, WEOutput, WEVars;
PROCEDURE TwoWayChat(Title:string; LineLen,ScreenHeight:integer);
CONST
MaxPhyLines=50;
TYPE
stringl=STRING[81];
VAR
ch:char;
x:integer;
s:string;
lastlocal:boolean;
RemoteTop : integer;
lx,ly,rx,ry : integer;
RemoteBottom : integer;
temp : string;
PROCEDURE WordWrap(VAR s1:StringL; VAR s2:string);
VAR
i,x:integer;
BEGIN
s2:='';
x:=length(s1);
WHILE (x>0) AND (NOT (s1[x]=' ')) DO
dec(x);
IF x<>0 THEN
BEGIN
s2 := copy(s1,x+1,length(s1)-x);
prompt(#27+'['+cstr(length(s1)-x)+'D');
clreol;
system.delete(s1,x+1,length(s2));
END;
writeln;
END;
PROCEDURE IncRY;
VAR x:integer;
BEGIN
inc(ry);
rx:=1;
IF ry>RemoteBottom THEN
BEGIN
FOR x:=1 TO 4 DO
BEGIN
Screen[RemoteTop+x-1].l:=Screen[RemoteBottom-4+x].l;
gotoxy(1,RemoteTop+x-1);
write(screen[remoteTop+x-1].l);
clreol;
END;
FOR x:=RemoteTop+4 TO RemoteBottom DO
BEGIN
Screen[x].l:='';
gotoxy(1,x);
clreol;
END;
ry:=RemoteTop+4;
rx:=1;
END;
gotoxy(rx,ry);
END;
PROCEDURE IncLY;
VAR x:integer;
BEGIN
inc(ly);
lx:=1;
IF ly>RemoteTop-2 THEN
BEGIN
FOR x:=1 TO 4 DO
BEGIN
Screen[x].l:=Screen[RemoteTop-6+x].l;
gotoxy(1,x);
write(Screen[x].l);
clreol;
END;
FOR x:=5 TO RemoteTop-2 DO
BEGIN
gotoxy(1,x);
Screen[x].l:='';
clreol;
END;
ly:=5;
lx:=1;
END;
gotoxy(lx,ly);
END;
PROCEDURE ControlX(l:integer);
BEGIN
Screen[l].l:='';
gotoxy(1,l);
clreol;
END;
PROCEDURE ControlW(l:integer; VAR x:integer);
BEGIN
WHILE (x>0) AND (screen[l].l[x]<>' ') DO
BEGIN
write(#8#32#8);
dec(x);
END;
screen[l].l[0]:=chr(x);
inc(x);
END;
BEGIN
FOR x:=1 TO MaxPhyLines DO
screen[x].l:='';
clrscr;
lastlocal:=true;
RemoteTop:=ScreenHeight DIV 2;
RemoteBottom := ScreenHeight-2;
lx:=1; ly:=2;
rx:=1; ry:=13;
SeperateLocalInput;
Ansic('7');
print('Chat mode:');
gotoxy(1,RemoteTop-1);
ansic('3');
prompt(dup('=',(LineLen-length(title)) div 2)+c4+Title+c3+dup('=',(LineLen-length(title)) div 2));
ansic('2');
gotoxy(lx,ly);
s:='';
REPEAT
REPEAT UNTIL KeyPressedL OR KeyPressed;
IF KeyPressedL THEN
BEGIN
ch:=readkeyL;
IF not LastLocal THEN
BEGIN
gotoxy(lx,ly);
ansic('2');
LastLocal:=true;
END;
IF NOT (ch IN [#0..#31]) THEN
BEGIN
Screen[ly].l:=Screen[ly].l+ch;
write(ch);
inc(lx);
IF lx>=LineLen THEN
BEGIN
wordwrap(screen[ly].l,temp);
IncLY;
screen[ly].l:=temp;
write(temp);
lx:=length(temp)+1;
END;
END
ELSE IF ch=^X THEN BEGIN ControlX(ly); lx:=1; END
ELSE IF ch=^W THEN ControlW(ly,lx)
ELSE IF ch=#13 THEN IncLY
ELSE IF ch=#27 THEN ch:=#255
ELSE IF ch=#8 THEN
IF lx>1 THEN BEGIN
dec(lx);
write(#8#32#8);
delete(Screen[ly].l,lx,1);
END
END
ELSE IF KeyPressed THEN
BEGIN
ch:=readkey;
IF lastlocal THEN
BEGIN
gotoxy(rx,ry);
ansic('1');
LastLocal:=false;
END;
IF NOT (Ch IN [#0..#31,#255]) THEN
BEGIN
Screen[ry].l:=Screen[ry].l+ch;
write(ch);
inc(rx);
IF rx>=LineLen THEN
BEGIN
wordwrap(screen[ry].l,temp);
incRY;
screen[ry].l:=temp;
write(temp);
rx:=length(temp)+1;
END;
END
ELSE IF ch=^X THEN BEGIN ControlX(ry); rx:=1; END
ELSE IF ch=^W THEN ControlW(ry,rx)
ELSE IF ch=#13 THEN IncRY
ELSE IF ch=#8 THEN
IF rx>1 THEN BEGIN
dec(rx);
write(#8#32#8);
delete(screen[ry].l,rx,1);
END
END
UNTIL ch=#255;
MergeLocalInput;
END;
PROCEDURE Chat(LineLen,ScreenHeight:integer);
{ Calls TwoWayChat, and then restores the screen afterwards }
VAR
ch:char;
BEGIN
ch:=DisplayColor;
TwoWayChat('WWIVEdit Two Way Chat',LineLen,ScreenHeight);
ansic(ch);
ForcedRedisplay;
END;
END.